home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / menubar-x.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-07  |  56.4 KB  |  1,920 lines
  1. /* Implements an elisp-programmable menubar -- X interface.
  2.    Copyright (C) 1993, 1994 Free Software Foundation, Inc.
  3.    Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
  4.  
  5. This file is part of XEmacs.
  6.  
  7. XEmacs is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with XEmacs; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20.  
  21. /* Synched up with: Not in FSF. */
  22.  
  23. /* created 16-dec-91 by jwz */
  24.  
  25. #include <config.h>
  26. #include "lisp.h"
  27.  
  28. #include "device-x.h"
  29. #include "frame-x.h"
  30. #ifdef LWLIB_USES_MOTIF
  31. #include <Xm/Xm.h> /* for XmVersion */
  32. #endif
  33. #include "EmacsManager.h"
  34. #include "EmacsFrame.h"
  35. #include "EmacsShell.h"
  36. #include "lwlib.h"
  37.  
  38. #include "buffer.h"
  39. #include "commands.h"           /* zmacs_regions */
  40. #include "events.h"
  41. #include "opaque.h"
  42. #include "window.h"
  43.  
  44. #define HAVE_DIALOG_BOXES
  45.  
  46. static int set_frame_menubar (struct frame *f,
  47.                   int deep_p,
  48.                   int first_time_p);
  49. void free_frame_menubar (struct frame *f);
  50. LWLIB_ID new_lwlib_id (void);
  51.  
  52. extern int menubar_show_keybindings;
  53. extern Lisp_Object Vmenubar_configuration;
  54.  
  55. /* we need a unique id for each popup menu and dialog box */
  56. static unsigned int lwlib_id_tick;
  57.  
  58. /* count of menus/dboxes currently up */
  59. int popup_menu_up_p;
  60.  
  61. int popup_menu_titles;
  62.  
  63. extern Lisp_Object Qcurrent_menubar;
  64. extern Lisp_Object Qmenu_no_selection_hook;
  65.  
  66. extern Lisp_Object Vthis_command_keys; /* event-stream.c */
  67.  
  68. #define MENUBAR_TYPE    0
  69. #define SUBMENU_TYPE    1
  70. #define POPUP_TYPE    2
  71.  
  72. LWLIB_ID
  73. new_lwlib_id (void)
  74. {
  75.   return ++lwlib_id_tick;
  76. }
  77.  
  78.  
  79. /* Converting Lisp menu tree descriptions to lwlib's `widget_value' form.
  80.  
  81.    menu_item_descriptor_to_widget_value() converts a lisp description of a
  82.    menubar into a tree of widget_value structures.  It allocates widget_values
  83.    with malloc_widget_value() and allocates other storage only for the `key'
  84.    slot.  All other slots are filled with pointers to Lisp_String data.  We
  85.    allocate a widget_value description of the menu or menubar, and hand it to
  86.    lwlib, which then makes a copy of it, which it manages internally.  We then
  87.    immediately free our widget_value tree; it will not be referenced again.
  88.  
  89.    Incremental menu construction callbacks operate just a bit differently.
  90.    They allocate widget_values and call replace_widget_value_tree() to tell
  91.    lwlib to destructively modify the incremental stub (subtree) of its
  92.    separate widget_value tree.
  93.  
  94.    This function is highly recursive (it follows the menu trees) and may call
  95.    eval.  The reason we keep pointers to lisp string data instead of copying
  96.    it and freeing it later is to avoid the speed penalty that would entail
  97.    (since this needs to be fast, in the simple cases at least).  (The reason
  98.    we malloc/free the keys slot is because there's not a lisp string around
  99.    for us to use in that case.)
  100.  
  101.    Since we keep pointers to lisp strings, and we call eval, we could lose if
  102.    GC relocates (or frees) those strings.  It's not easy to gc protect the
  103.    strings because of the recursive nature of this function, and the fact that
  104.    it returns a data structure that gets freed later.  So...  we do the
  105.    sleaziest thing possible and inhibit GC for the duration.  This is probably
  106.    not a big deal...
  107.  
  108.    We do not have to worry about the pointers to Lisp_String data after
  109.    this function successfully finishes.  lwlib copies all such data with
  110.    strdup().
  111.  
  112.    */
  113.  
  114. #if 1
  115.   /* Eval the activep slot of the menu item */
  116. # define wv_set_evalable_slot(slot,form)    \
  117.    do { Lisp_Object _f_ = (form);        \
  118.       slot = (NILP (_f_) ? 0 :         \
  119.           EQ (_f_, Qt) ? 1 :        \
  120.           !NILP (Feval (_f_)));        \
  121.       } while (0)
  122. #else
  123.   /* Treat the activep slot of the menu item as a boolean */
  124. # define wv_set_evalable_slot(slot,form)    \
  125.       slot = (!NILP ((form)))
  126. #endif
  127.  
  128. widget_value *
  129. xmalloc_widget_value (void)
  130. {
  131.   widget_value *tmp = malloc_widget_value ();
  132.   if (!tmp) memory_full ();
  133.   return tmp;
  134. }
  135.  
  136. /* menu_item_descriptor_to_widget_value() mallocs a widget_value, but then
  137.    may signal lisp errors.  If an error does not occur, the opaque ptr we have
  138.    here has had its pointer set to 0 to tell us not to do anything.
  139.    Otherwise we free the widget value.  (This has nothing to do with GC, it's
  140.    just about not dropping pointers to malloc'd data when errors happen.)
  141.  */
  142. static Lisp_Object
  143. widget_value_unwind (Lisp_Object closure)
  144. {
  145.   widget_value *wv = (widget_value *) get_opaque_ptr (closure);
  146.   if (wv)
  147.     free_widget_value (wv);
  148.   return Qnil;
  149. }
  150.  
  151. static Boolean
  152. separator_string_p (char *s)
  153. {
  154.   char *p, first;
  155.   if (!s || s[0] == '\0')
  156.     return False;
  157.   first = s[0];
  158.   if (first != '-' && first != '=')
  159.     return False;
  160.   for (p = s; *p == first; p++);
  161.  
  162.   if (*p == '!' || *p == ':' || *p == '\0')
  163.     return True;
  164.   return False;
  165. }
  166.  
  167. static char *
  168. menu_separator_style (char *s)
  169. {
  170.   char *p, first;
  171.   if (!s || s[0] == '\0')
  172.     return NULL;
  173.   first = s[0];
  174.   if (first != '-' && first != '=')
  175.     return NULL;
  176.   for (p = s; *p == first; p++);
  177.  
  178.   /* #### - cannot currently specify a separator tag "--!tag" and a
  179.      separator style "--:style" at the same time. */
  180.   /* #### - Also, the motif menubar code doesn't deal with the
  181.      double etched style yet, so it's not good to get into the habit of
  182.      using "===" in menubars to get double-etched lines */
  183.   if (*p == '!' || *p == '\0')
  184.     return ((first == '-')
  185.         ? NULL        /* single etched is the default */
  186.         : xstrdup ("shadowDoubleEtchedIn"));
  187.   else if (*p == ':')
  188.     return xstrdup (p+1);
  189.     
  190.   return NULL;
  191. }
  192.  
  193. /* This does the dirty work.  gc_currently_forbidden is 1 when this is called.
  194.  */
  195.  
  196. static int
  197. menu_item_leaf_to_widget_value (Lisp_Object desc, widget_value *wv,
  198.                 int allow_text_field_p, int no_keys_p)
  199. {
  200.   /* !!#### This function has not been Mule-ized */
  201.   /* This function cannot GC because gc_currently_forbidden is set when
  202.      it's called */
  203.   Lisp_Object name = Qnil;
  204.   Lisp_Object callback = Qnil;
  205.   Lisp_Object suffix = Qnil;
  206.   Lisp_Object active_p = Qt;
  207.   Lisp_Object include_p = Qt;
  208.   Lisp_Object selected_p = Qnil;
  209.   Lisp_Object keys = Qnil;
  210.   Lisp_Object style = Qnil;
  211.   Lisp_Object config_tag = Qnil;
  212.   int length = vector_length (XVECTOR (desc));
  213.   Lisp_Object *contents = vector_data (XVECTOR (desc));
  214.   int plist_p;
  215.   int selected_spec = 0, included_spec = 0;
  216.  
  217.   if (length < 3)
  218.     signal_simple_error ("button descriptors must be at least 3 long", desc);
  219.  
  220.   /* length 3:        [ "name" callback active-p ]
  221.      length 4:        [ "name" callback active-p suffix ]
  222.                 or    [ "name" callback keyword  value  ]
  223.      length 5+:        [ "name" callback [ keyword value ]+ ]
  224.    */
  225.   plist_p = (length >= 5 || KEYWORDP (contents [2]));
  226.  
  227.   if (!plist_p)
  228.     /* the old way */
  229.     {
  230.       name = contents [0];
  231.       callback = contents [1];
  232.       active_p = contents [2];
  233.       if (length == 4)
  234.     suffix = contents [3];
  235.     }
  236.   else
  237.     {
  238.       /* the new way */
  239.       int i;
  240.       if (length & 1)
  241.     signal_simple_error (
  242.         "button descriptor has an odd number of keywords and values",
  243.                  desc);
  244.  
  245.       name = contents [0];
  246.       callback = contents [1];
  247.       for (i = 2; i < length;)
  248.     {
  249.       Lisp_Object key = contents [i++];
  250.       Lisp_Object val = contents [i++];
  251.       if (!KEYWORDP (key))
  252.         signal_simple_error_2 ("not a keyword", key, desc);
  253.  
  254.       if      (EQ (key, Q_active))   active_p = val;
  255.       else if (EQ (key, Q_suffix))   suffix = val;
  256.       else if (EQ (key, Q_keys))     keys = val;
  257.       else if (EQ (key, Q_style))    style = val;
  258.       else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1;
  259.       else if (EQ (key, Q_included)) include_p = val, included_spec = 1;
  260.       else if (EQ (key, Q_config))     config_tag = val;
  261.       else if (EQ (key, Q_filter))
  262.         signal_simple_error(":filter keyword not permitted on leaf nodes", desc);
  263.       else 
  264.         signal_simple_error_2 ("unknown menu item keyword", key, desc);
  265.     }
  266.     }
  267.  
  268.   if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration)))
  269.       || (included_spec && NILP (Feval (include_p))))
  270.     {
  271.       /* the include specification says to ignore this item. */
  272.       return 0;
  273.     }
  274.  
  275.   CHECK_STRING (name, 0);
  276.   wv->name = (char *) string_data (XSTRING (name));
  277.  
  278.   if (!NILP (suffix))
  279.     {
  280.       CHECK_STRING (suffix, 0);
  281.       wv->value = xstrdup((char *) string_ext_data (XSTRING (suffix)));
  282.     }
  283.  
  284.   wv_set_evalable_slot (wv->enabled, active_p);
  285.   wv_set_evalable_slot (wv->selected, selected_p);
  286.  
  287.   wv->call_data = LISP_TO_VOID (callback);
  288.  
  289.   if (no_keys_p || !menubar_show_keybindings)
  290.     wv->key = 0;
  291.   else if (!NILP (keys))    /* Use this string to generate key bindings */
  292.     {
  293.       CHECK_STRING (keys, 0);
  294.       keys = Fsubstitute_command_keys (keys);
  295.       if (string_length (XSTRING (keys)) > 0)
  296.     wv->key = xstrdup ((char *) string_data (XSTRING (keys)));
  297.       else
  298.     wv->key = 0;
  299.     }
  300.   else if (SYMBOLP (callback))    /* Show the binding of this command. */
  301.     {
  302.       char buf [1024];
  303.       /* #### Warning, dependency here on current_buffer and point */
  304.       where_is_to_char (callback, buf);
  305.       if (buf [0])
  306.     wv->key = xstrdup (buf);
  307.       else
  308.     wv->key = 0;
  309.     }
  310.  
  311.   CHECK_SYMBOL (style, 0);
  312.   if (NILP (style))
  313.     {
  314.       /* If the callback is nil, treat this item like unselectable text.
  315.      This way, dashes will show up as a separator. */
  316.       if (!wv->enabled)
  317.     wv->type = BUTTON_TYPE;
  318.       if (separator_string_p (wv->name))
  319.     {
  320.       wv->type = SEPARATOR_TYPE;
  321.       wv->value = menu_separator_style (wv->name);
  322.     }
  323.       else
  324.     {
  325. #if 0
  326.       /* #### - this is generally desirable for menubars, but it breaks
  327.          a package that uses dialog boxes and next_command_event magic
  328.          to use the callback slot in dialog buttons for data instead of
  329.          a real callback.
  330.  
  331.          Code is data, right?  The beauty of LISP abuse.   --Stig */
  332.       if (NILP (callback))
  333.         wv->type = TEXT_TYPE;
  334.       else
  335. #endif
  336.         wv->type = BUTTON_TYPE;
  337.     }
  338.     }
  339.   else if (EQ (style, Qbutton))
  340.     wv->type = BUTTON_TYPE;
  341.   else if (EQ (style, Qtoggle))
  342.     wv->type = TOGGLE_TYPE;
  343.   else if (EQ (style, Qradio))
  344.     wv->type = RADIO_TYPE;
  345.   else if (EQ (style, Qtext))
  346.     {
  347.       wv->type = TEXT_TYPE;
  348. #if 0
  349.       wv->value = wv->name;
  350.       wv->name = "value";
  351. #endif 
  352.     }
  353.   else
  354.     signal_simple_error_2 ("unknown style", style, desc);
  355.  
  356.   if (!allow_text_field_p && (wv->type == TEXT_TYPE))
  357.     signal_simple_error ("text field not allowed in this context", desc);
  358.  
  359.   if (selected_spec && EQ (style, Qtext))
  360.     signal_simple_error (
  361.          ":selected only makes sense with :style toggle, radio or button",
  362.              desc);
  363.   return 1;
  364. }
  365.  
  366. static widget_value *
  367. menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, 
  368.                     int menu_type, int deep_p,
  369.                     int filter_p,
  370.                     int depth)
  371. {
  372.   /* This function cannot GC.
  373.      It is only called from menu_item_descriptor_to_widget_value, which
  374.      prohibits GC. */
  375.   /* !!#### This function has not been Mule-ized */
  376.   int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
  377.   widget_value *wv;
  378.   Lisp_Object wv_closure;
  379.   int count = specpdl_depth ();
  380.   int partition_seen = 0;
  381.  
  382.   wv = xmalloc_widget_value ();
  383.  
  384.   wv_closure = make_opaque_ptr (wv);
  385.   record_unwind_protect (widget_value_unwind, wv_closure);
  386.  
  387.   if (STRINGP (desc))
  388.     {
  389.       char *string_chars = (char *) string_data (XSTRING (desc));
  390.       wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE :
  391.           TEXT_TYPE);
  392. #if 1
  393.       /* #### - should internationalize with X resources instead.
  394.          Not so! --ben */
  395.       string_chars = GETTEXT (string_chars);
  396. #endif
  397.       if (wv->type == SEPARATOR_TYPE)
  398.     {
  399.       wv->value = menu_separator_style (string_chars);
  400.     } 
  401.       else
  402.     {
  403.       wv->name = string_chars;
  404.       wv->enabled = 1;
  405.     }
  406.     }
  407.   else if (VECTORP (desc))
  408.     {
  409.       if (!menu_item_leaf_to_widget_value (desc, wv, 1,
  410.                        (menu_type == MENUBAR_TYPE
  411.                         && depth <= 1)))
  412.     {
  413.       /* :included form was nil */
  414.       wv = NULL;
  415.       goto menu_item_done;
  416.     }
  417.     }
  418.   else if (CONSP (desc))
  419.     {
  420.       Lisp_Object incremental_data = desc;
  421.       widget_value *prev = 0;
  422.  
  423.       if (STRINGP (XCAR (desc)))
  424.     {
  425.       Lisp_Object key, val;
  426.       Lisp_Object include_p, hook_fn = Qnil, config_tag = Qnil;
  427.       int included_spec = 0;
  428.       wv->type = CASCADE_TYPE;
  429.       wv->enabled = 1;
  430.       wv->name =
  431.         (char *) string_data (XSTRING (LISP_GETTEXT (XCAR (desc))));
  432.       desc = Fcdr (desc);
  433.  
  434.       while (key = Fcar (desc), KEYWORDP (key))
  435.         {
  436.           Lisp_Object cascade = desc;
  437.           desc = Fcdr (desc);
  438.           if (NILP (desc))
  439.         signal_simple_error ("keyword in menu lacks a value",
  440.                      cascade); 
  441.           val = Fcar (desc);
  442.           desc = Fcdr (desc);
  443.           if (EQ (key, Q_included))
  444.         include_p = val, included_spec = 1;
  445.           else if (EQ (key, Q_config))
  446.         config_tag = val;
  447.           else if (EQ (key, Q_filter))
  448.         hook_fn = val;
  449.           else 
  450.         signal_simple_error ("unknown menu cascade keyword", cascade);
  451.         }
  452.  
  453.       if ((!NILP (config_tag)
  454.            && NILP (Fmemq (config_tag, Vmenubar_configuration)))
  455.           || (included_spec && NILP (Feval (include_p))))
  456.         {
  457.           wv = NULL;
  458.           goto menu_item_done;
  459.         }
  460.       if (!NILP (hook_fn))
  461.         {
  462. #ifdef LWLIB_MENUBARS_LUCID
  463.           if (filter_p || depth == 0)
  464.         {
  465. #endif 
  466.           desc = call1 (hook_fn, desc);
  467. #ifdef LWLIB_MENUBARS_LUCID
  468.         }
  469.           else
  470.         {
  471.           widget_value *incr_wv = xmalloc_widget_value ();
  472.           wv->contents = incr_wv;
  473.           incr_wv->type = INCREMENTAL_TYPE;
  474.           incr_wv->enabled = 1;
  475.           incr_wv->name = wv->name;
  476.           /* This is automatically GC protected through
  477.              the call to lw_map_widget_values(); no need
  478.              to worry. */
  479.           incr_wv->call_data = LISP_TO_VOID (incremental_data);
  480.           goto menu_item_done;
  481.         }
  482. #endif
  483.         }
  484.       if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0)
  485.         {
  486.           /* Simply prepend three more widget values to the contents of
  487.          the menu: a label, and two separators (to get a double
  488.          line). */
  489.           widget_value *title_wv = xmalloc_widget_value ();
  490.           widget_value *sep_wv = xmalloc_widget_value ();
  491.           title_wv->type = TEXT_TYPE;
  492.           title_wv->name = wv->name;
  493.           title_wv->enabled = 1;
  494.           title_wv->next = sep_wv;
  495.           sep_wv->type = SEPARATOR_TYPE;
  496.           sep_wv->value = menu_separator_style ("==");
  497.           sep_wv->next = 0;
  498.           
  499.           wv->contents = title_wv;
  500.           prev = sep_wv;
  501.         }
  502.     }
  503.       else if (menubar_root_p)
  504.     {
  505.       wv->name = "menubar";
  506.       wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
  507.                       this is ignored anyway...  */
  508.     }
  509.       else
  510.     {
  511.       signal_simple_error ("menu name (first element) must be a string",
  512.                                desc);
  513.     }
  514.  
  515.       wv->enabled = 1;
  516.       if (deep_p || menubar_root_p)
  517.     {
  518.       widget_value *next;
  519.       for (; !NILP (desc); desc = Fcdr (desc))
  520.         {
  521.           Lisp_Object child = Fcar (desc);
  522.           if (menubar_root_p && NILP (child))    /* the partition */
  523.         {
  524.           if (partition_seen)
  525.             error (
  526.              "more than one partition (nil) in menubar description");
  527.           partition_seen = 1;
  528.           next = xmalloc_widget_value ();
  529.           next->type = PUSHRIGHT_TYPE;
  530.         }
  531.           else
  532.         {
  533.           next = menu_item_descriptor_to_widget_value_1 (child,
  534.                                  menu_type,
  535.                                  deep_p,
  536.                                  filter_p,
  537.                                  depth + 1);
  538.         }
  539.           if (! next)
  540.         continue;
  541.           else if (prev)
  542.         prev->next = next;
  543.           else
  544.         wv->contents = next;
  545.           prev = next;
  546.         }
  547.     }
  548.       if (deep_p && !wv->contents)
  549.     wv = NULL;
  550.     }
  551.   else if (NILP (desc))
  552.     error ("nil may not appear in menu descriptions");
  553.   else
  554.     signal_simple_error ("unrecognized menu descriptor", desc);
  555.  
  556. menu_item_done:
  557.  
  558.   if (wv)
  559.     {
  560.       /* Completed normally.  Clear out the object that widget_value_unwind()
  561.      will be called with to tell it not to free the wv (as we are
  562.      returning it.) */
  563.       set_opaque_ptr (wv_closure, 0);
  564.     }
  565.  
  566.   unbind_to (count, Qnil);
  567.   return wv;
  568. }
  569.  
  570.  
  571. #if 0
  572. static void
  573. print_widget_value (widget_value *wv, int depth)
  574. {
  575.   /* !!#### This function has not been Mule-ized */
  576.   char d [200];
  577.   int i;
  578.   for (i = 0; i < depth; i++) d[i] = ' ';
  579.   d[depth]=0;
  580.   /* #### - print type field */
  581.   printf ("%sname:    %s\n", d, (wv->name ? wv->name : "(null)"));
  582.   if (wv->value) printf ("%svalue:   %s\n", d, wv->value);
  583.   if (wv->key)   printf ("%skey:     %s\n", d, wv->key);
  584.   printf ("%senabled: %d\n", d, wv->enabled);
  585.   if (wv->contents)
  586.     {
  587.       printf ("\n%scontents: \n", d);
  588.       print_widget_value (wv->contents, depth + 5);
  589.     }
  590.   if (wv->next)
  591.     {
  592.       printf ("\n");
  593.       print_widget_value (wv->next, depth);
  594.     }
  595. }
  596. #endif
  597.  
  598. static widget_value *
  599. menu_item_descriptor_to_widget_value (Lisp_Object desc, 
  600.                       int menu_type, /* if this is a menubar,
  601.                              popup or sub menu */
  602.                       int deep_p,    /*  */
  603.                       int filter_p)  /* if :filter forms
  604.                             should run now */ 
  605. {
  606.   widget_value *wv;
  607.   int count = specpdl_depth ();
  608.   record_unwind_protect (restore_gc_inhibit,
  609.              make_number (gc_currently_forbidden));
  610.   gc_currently_forbidden = 1;
  611.   /* Can't GC! */
  612.   wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p,
  613.                            filter_p, 0);
  614.   unbind_to (count, Qnil);
  615.   return wv;
  616. }
  617.  
  618.  
  619. /* This recursively calls free_widget_value() on the tree of widgets.
  620.    It must free all data that was malloc'ed for these widget_values.
  621.  
  622.    It used to be that emacs only allocated new storage for the `key' slot.
  623.    All other slots are pointers into the data of Lisp_Strings, and must be
  624.    left alone.  */
  625. static void
  626. free_menubar_widget_value_tree (widget_value *wv)
  627. {
  628.   if (! wv) return;
  629.   if (wv->key) xfree (wv->key);
  630.   if (wv->value) xfree (wv->value);
  631.  
  632.   wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
  633.  
  634.   if (wv->contents && (wv->contents != (widget_value*)1))
  635.     {
  636.       free_menubar_widget_value_tree (wv->contents);
  637.       wv->contents = (widget_value *) 0xDEADBEEF;
  638.     }
  639.   if (wv->next)
  640.     {
  641.       free_menubar_widget_value_tree (wv->next);
  642.       wv->next = (widget_value *) 0xDEADBEEF;
  643.     }
  644.   free_widget_value (wv);
  645. }
  646.  
  647.  
  648. /* There is exactly one of these per frame. 
  649.    It doesn't really need to be an lrecord (it's not lisp-accessible)
  650.    but it makes marking slightly more modular.
  651.  */
  652.  
  653. struct menubar_data
  654. {
  655.   struct lcrecord_header header;
  656.  
  657.   /* lwlib ID of the tree of widgets corresponding to this menubar.
  658.      We pass this to lw_map_widget_values() to retrieve all of our
  659.      Lispy call-data values that need to be GCPRO'd. */
  660.   LWLIB_ID id;
  661.  
  662.   /* This is the last buffer for which the menubar was displayed.
  663.      If the buffer has changed, we may have to update things. */
  664.   Lisp_Object last_menubar_buffer;
  665.  
  666.   /* This flag tells us if the menubar contents are up-to-date with respect
  667.      to the current menubar structure.  If we want to actually pull down a
  668.      menu and this is false, then we need to update things. */
  669.   char menubar_contents_up_to_date;
  670. };
  671.  
  672. DECLARE_LRECORD (menubar_data, struct menubar_data);
  673. #define XMENUBAR_DATA(x) XRECORD (x, menubar_data, struct menubar_data)
  674. #define XSETMENUBAR_DATA(x, p) XSETRECORD (x, p, menubar_data)
  675. #define MENUBAR_DATAP(x) RECORDP (x, menubar_data)
  676. #define CHECK_MENUBAR_DATA(x, i) CHECK_RECORD (x, menubar_data)
  677.  
  678. static Lisp_Object mark_menubar_data (Lisp_Object obj,
  679.                       void (*markobj) (Lisp_Object));
  680. DEFINE_LRECORD_IMPLEMENTATION ("menubar-data", menubar_data,
  681.                                mark_menubar_data, 0, 0, 0, 0,
  682.                    struct menubar_data);
  683.  
  684. struct mark_widget_value_closure
  685. {
  686.   void (*markobj) (Lisp_Object);
  687. };
  688.  
  689. static int
  690. mark_widget_value_mapper (widget_value *val, void *closure)
  691. {
  692.   Lisp_Object markee;
  693.  
  694.   struct mark_widget_value_closure *cl =
  695.     (struct mark_widget_value_closure *) closure;
  696.   if (val->call_data)
  697.     {
  698.       VOID_TO_LISP (markee, val->call_data);
  699.       (cl->markobj) (markee);
  700.     }
  701.  
  702.   return 0;
  703. }
  704.  
  705. static Lisp_Object
  706. mark_menubar_data (Lisp_Object obj, void (*markobj) (Lisp_Object))
  707. {
  708.   struct menubar_data *data = (struct menubar_data *) XMENUBAR_DATA (obj);
  709.  
  710.   /* Now mark the callbacks and such that are hidden in the lwlib
  711.      call-data */
  712.  
  713.   if (data->id)
  714.     {
  715.       struct mark_widget_value_closure closure;
  716.  
  717.       closure.markobj = markobj;
  718.       lw_map_widget_values (data->id, mark_widget_value_mapper, &closure);
  719.     }
  720.   
  721.   return (data->last_menubar_buffer);
  722. }
  723.  
  724. #define FRAME_MENUBAR_DATA(frame) \
  725.   ((struct menubar_data *) XMENUBAR_DATA ((frame)->menubar_data))
  726.  
  727. /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of
  728.    (id . menubar-data) for GCPRO'ing the callbacks of the popup menus
  729.    and dialog boxes. */
  730. static Lisp_Object Vpopup_callbacks;
  731.  
  732. static void
  733. gcpro_popup_callbacks (LWLIB_ID id)
  734. {
  735.   struct menubar_data *mdata;
  736.   Lisp_Object lid = make_number (id);
  737.   Lisp_Object lmdata = Qnil;
  738.  
  739.   assert (NILP (assq_no_quit (lid, Vpopup_callbacks)));
  740.   mdata = alloc_lcrecord (sizeof (struct menubar_data), lrecord_menubar_data);
  741.   mdata->id = id;
  742.   mdata->last_menubar_buffer = Qnil;
  743.   mdata->menubar_contents_up_to_date = 0;
  744.   XSETMENUBAR_DATA (lmdata, mdata);
  745.   Vpopup_callbacks = Fcons (Fcons (lid, lmdata), Vpopup_callbacks);
  746. }
  747.  
  748. static void
  749. ungcpro_popup_callbacks (LWLIB_ID id)
  750. {
  751.   Lisp_Object lid = make_number (id);
  752.   Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks);
  753.   assert (!NILP (this));
  754.   Vpopup_callbacks = delq_no_quit (this, Vpopup_callbacks);
  755. }
  756.  
  757. /* The order in which callbacks are run is funny to say the least.
  758.    It's sometimes tricky to avoid running a callback twice, and to
  759.    avoid returning prematurely.  So, this function returns true
  760.    if the menu's callbacks are no longer gc protected.  So long
  761.    as we unprotect them before allowing other callbacks to run,
  762.    everything should be ok.
  763.  
  764.    The pre_activate_callback() *IS* intentionally called multiple times.
  765.    If client_data == NULL, then it's being called before the menu is posted.
  766.    If client_data != NULL, then client_data is a (widget_value *) and
  767.    client_data->data is a Lisp_Object pointing to a lisp submenu description
  768.    that must be converted into widget_values.  *client_data is destructively
  769.    modified. 
  770.  
  771.    #### Stig thinks that there may be a GC problem here due to the
  772.    fact that pre_activate_callback() is called multiple times, but I
  773.    think he's wrong.
  774.  
  775.    */
  776.  
  777. static int
  778. popup_handled_p (LWLIB_ID id)
  779. {
  780.   return (NILP (assq_no_quit (make_number (id), Vpopup_callbacks)));
  781. }
  782.  
  783. extern Lisp_Object Vactivate_menubar_hook;
  784.  
  785. static void
  786. pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
  787. {
  788.   /* This function can GC */
  789.   struct gcpro gcpro1;
  790.   struct device *d = get_device_from_display (XtDisplay (widget));
  791.   struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
  792.   Lisp_Object rest = Qnil;
  793.   int any_changes = 0;
  794.  
  795.   if (!f)
  796.     f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
  797.   if (!f)
  798.     return;
  799.  
  800.   if (client_data)
  801.     {
  802.       /* this is an incremental menu construction callback */
  803.       widget_value *hack_wv = (widget_value *) client_data;
  804.       Lisp_Object submenu_desc;
  805.       widget_value *wv;
  806.  
  807.       assert (hack_wv->type == INCREMENTAL_TYPE);
  808.       VOID_TO_LISP (submenu_desc, hack_wv->call_data);
  809.       wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE,
  810.                          1, 1);
  811.       if (!wv)
  812.     {
  813.       wv = xmalloc_widget_value ();
  814.       wv->type = CASCADE_TYPE;
  815.       wv->next = NULL;
  816.       wv->contents = xmalloc_widget_value ();
  817.       wv->contents->type = TEXT_TYPE;
  818.       wv->contents->name = "No menu";
  819.       wv->contents->next = NULL;
  820.     }
  821.       assert (wv && wv->type == CASCADE_TYPE && wv->contents);
  822.       replace_widget_value_tree (hack_wv, wv->contents);
  823.       free_menubar_widget_value_tree (wv);
  824.     }
  825.   else
  826.     {
  827.       if (!MENUBAR_DATAP (f->menubar_data))
  828.     return;
  829.       /* #### - this menubar update mechanism is expensively anti-social and
  830.      the activate-menubar-hook is now mostly obsolete. */
  831.       /* make the activate-menubar-hook be a list of functions, not a single
  832.      function, just to simplify things. */
  833.       if (!NILP (Vactivate_menubar_hook) &&
  834.       (!CONSP (Vactivate_menubar_hook) ||
  835.        EQ (XCAR (Vactivate_menubar_hook), Qlambda)))
  836.     Vactivate_menubar_hook = Fcons (Vactivate_menubar_hook, Qnil);
  837.       
  838.       GCPRO1 (rest);
  839.       for (rest = Vactivate_menubar_hook; !NILP (rest); rest = Fcdr (rest))
  840.     if (!EQ (call0 (XCAR (rest)), Qt))
  841.       any_changes = 1;
  842. #if 0
  843.       /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
  844.      incremental menus are implemented.  If a subtree of a menu has been
  845.      updated incrementally (a destructive operation), then that subtree
  846.      must somehow be wiped.
  847.  
  848.      It is difficult to undo the destructive operation in lwlib because
  849.      a pointer back to lisp data needs to be hidden away somewhere.  So
  850.      that an INCREMENTAL_TYPE widget_value can be recreated...  Hmmmmm. */
  851.       if (any_changes ||
  852.       !FRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
  853. #endif 
  854.     set_frame_menubar (f, 1, 0);
  855.       UNGCPRO;
  856.     }
  857. }
  858.  
  859. /* The following is actually called from somewhere within XtDispatchEvent(),
  860.    called from XtAppProcessEvent() in event-Xt.c */
  861.  
  862. static void
  863. menubar_selection_callback (Widget widget, LWLIB_ID ignored_id,
  864.                 XtPointer client_data)
  865. {
  866.   Lisp_Object fn, arg;
  867.   Lisp_Object data;
  868.  
  869.   if (((LISP_WORD_TYPE) client_data) == 0)
  870.     return;
  871.  
  872.   VOID_TO_LISP (data, client_data);
  873.  
  874. #if 0
  875.   /* #### What the hell?  I can't understand why this call is here,
  876.      and doing it is really courting disaster in the new event
  877.      model, since menubar_selection_callback is called from
  878.      within next_event_internal() and Faccept_process_output()
  879.      itself calls next_event_internal().  --Ben */
  880.  
  881.   /* Flush the X and process input */
  882.   Faccept_process_output (Qnil, Qnil, Qnil);
  883. #endif
  884.  
  885.   if (((LISP_WORD_TYPE) client_data) == -1)
  886.     {
  887.       fn = Vrun_hooks;
  888.       arg = Qmenu_no_selection_hook;
  889.       if (NILP (fn))
  890.         fn = Qsymbolp;          /* something innocuous */
  891.     }
  892.   else if (SYMBOLP (data))
  893.     {
  894.       fn = Qcall_interactively;
  895.       arg = data;
  896.     }
  897.   else if (CONSP (data))
  898.     {
  899.       fn = Qeval;
  900.       arg = data;
  901.     }
  902.   else
  903.     {
  904.       fn = Qeval;
  905.       arg = list3 (Qsignal,
  906.                    list2 (Qquote, Qerror),
  907.                    list2 (Qquote, list2 (build_translated_string
  908.                      ("illegal menu callback"),
  909.                                          data)));
  910.     }
  911.  
  912.   /* This is the timestamp used for asserting focus so we need to get an
  913.      up-to-date value event if no events has been dispatched to emacs
  914.      */
  915.   {
  916.     struct device *d = get_device_from_display (XtDisplay (widget));
  917.     DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d);
  918.   }
  919.  
  920.   signal_special_Xt_user_event (fn, arg);
  921. }
  922.  
  923. #ifdef ENERGIZE
  924. extern int *get_psheets_for_buffer (Lisp_Object, int *);
  925.  
  926. static void
  927. set_panel_button_sensitivity (struct frame *f, widget_value *data)
  928. {
  929.   struct window *window = XWINDOW (f->selected_window);
  930.   int current_buffer_psheets_count = 0;
  931.   int *current_buffer_psheets =
  932.     get_psheets_for_buffer (window->buffer, ¤t_buffer_psheets_count);
  933.   int panel_enabled = FRAME_X_DESIRED_PSHEETS (f) ||
  934.     current_buffer_psheets_count;
  935.   widget_value *val;
  936.   for (val = data->contents; val; val = val->next)
  937.     if (val->name && !strcmp (val->name, "sheet"))
  938.       {
  939.     val->enabled = panel_enabled;
  940.     return;
  941.       }
  942. }
  943. #endif /* ENERGIZE */
  944.  
  945. static widget_value*
  946. compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
  947. {
  948.   widget_value *data;
  949.  
  950.   if (NILP (menubar))
  951.     data = 0;
  952.   else
  953.     {
  954.       data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
  955.                            deep_p, 0);
  956. #ifdef ENERGIZE
  957.       if (data)
  958.     set_panel_button_sensitivity (f, data);
  959. #endif
  960.     }
  961.   return data;
  962. }
  963.  
  964. static Lisp_Object Vblank_menubar;
  965.  
  966. static int
  967. set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
  968. {
  969.   widget_value *data;
  970.   Lisp_Object menubar;
  971.   int menubar_visible;
  972.   long id;
  973.   struct window *w = XWINDOW (f->selected_window);
  974.  
  975.   if (! FRAME_IS_X (f))
  976.     return 0;
  977.  
  978.   /***** first compute the contents of the menubar *****/
  979.  
  980.   if (! first_time_p)
  981.     {
  982.       /* evaluate `current-menubar' in the buffer of the selected window
  983.      of the frame in question. */
  984.       menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
  985.     }
  986.   else
  987.     {
  988.       /* That's a little tricky the first time since the frame isn't
  989.      fully initialized yet. */
  990.       menubar = Fsymbol_value (Qcurrent_menubar);
  991.     }
  992.  
  993.   if (NILP (menubar))
  994.     {
  995.       menubar = Vblank_menubar;
  996.       menubar_visible = 0;
  997.     }
  998.   else
  999.     menubar_visible = !NILP (w->menubar_visible_p);
  1000.  
  1001.   data = compute_menubar_data (f, menubar, deep_p);
  1002.   if (!data || (!data->next && !data->contents))
  1003.     abort ();
  1004.   
  1005.   if (NILP (f->menubar_data))
  1006.     {
  1007.       struct menubar_data *mdata =
  1008.     alloc_lcrecord (sizeof (struct menubar_data), lrecord_menubar_data);
  1009.  
  1010.       mdata->id = new_lwlib_id ();
  1011.       mdata->last_menubar_buffer = Qnil;
  1012.       mdata->menubar_contents_up_to_date = 0;
  1013.       XSETMENUBAR_DATA (f->menubar_data, mdata);
  1014.     }
  1015.  
  1016.   /***** now store into the menubar widget, creating it if necessary *****/
  1017.  
  1018.   id = FRAME_MENUBAR_DATA (f)->id;
  1019.   if (!FRAME_X_MENUBAR_WIDGET (f))
  1020.     {
  1021.       Widget parent = FRAME_X_CONTAINER_WIDGET (f);
  1022.  
  1023.       assert (first_time_p);
  1024.  
  1025.       /* It's the first time we've mapped the menubar so compute its
  1026.      contents completely once.  This makes sure that the menubar
  1027.      components are created with the right type. */
  1028.       if (!deep_p)
  1029.     {
  1030.       free_menubar_widget_value_tree (data);
  1031.       data = compute_menubar_data (f, menubar, 1);
  1032.     }
  1033.  
  1034.  
  1035.       FRAME_X_MENUBAR_WIDGET (f) =
  1036.     lw_create_widget ("menubar", "menubar", id, data, parent,
  1037.               0, pre_activate_callback,
  1038.               menubar_selection_callback, 0);
  1039.  
  1040.     }
  1041.   else
  1042.     {
  1043.       lw_modify_all_widgets (id, data, deep_p ? True : False);
  1044.     }
  1045.   free_menubar_widget_value_tree (data);
  1046.       
  1047.   FRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p;
  1048.   FRAME_MENUBAR_DATA (f)->last_menubar_buffer =
  1049.     XWINDOW (f->selected_window)->buffer;
  1050.   return menubar_visible;
  1051. }
  1052.  
  1053.  
  1054. /* Called from x_create_widgets() to create the inital menubar of a frame
  1055.    before it is mapped, so that the window is mapped with the menubar already
  1056.    there instead of us tacking it on later and thrashing the window after it
  1057.    is visible. */
  1058. int
  1059. initialize_frame_menubar (struct frame *f)
  1060. {
  1061.   return set_frame_menubar (f, 1, 1);
  1062. }
  1063.  
  1064.  
  1065. static LWLIB_ID last_popup_selection_callback_id;
  1066.  
  1067. static void
  1068. popup_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
  1069. {
  1070.   last_popup_selection_callback_id = id;
  1071.   menubar_selection_callback (widget, id, client_data);
  1072.   /* lw_destroy_all_widgets() will be called from popup_down_callback() */
  1073. }
  1074.  
  1075. static void
  1076. popup_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
  1077. {
  1078.   if (popup_handled_p (id))
  1079.     return;
  1080.   assert (popup_menu_up_p != 0);
  1081.   ungcpro_popup_callbacks (id);
  1082.   popup_menu_up_p--;
  1083.   /* if this isn't called immediately after the selection callback, then
  1084.      there wasn't a menu selection. */
  1085.   if (id != last_popup_selection_callback_id)
  1086.     menubar_selection_callback (widget, id, (XtPointer) -1);
  1087.   lw_destroy_all_widgets (id);
  1088. }
  1089.  
  1090. #ifdef HAVE_DIALOG_BOXES
  1091.  
  1092. static void
  1093. maybe_run_dbox_text_callback (LWLIB_ID id)
  1094. {
  1095.   /* !!#### This function has not been Mule-ized */
  1096.   widget_value *wv;
  1097.   int got_some;
  1098.   wv = xmalloc_widget_value ();
  1099.   wv->name = "value";
  1100.   got_some = lw_get_some_values (id, wv);
  1101.   if (got_some)
  1102.     {
  1103.       Lisp_Object text_field_callback;
  1104.       char *text_field_value = wv->value;
  1105.       VOID_TO_LISP (text_field_callback, wv->call_data);
  1106.       if (text_field_value)
  1107.     {
  1108.       void *tmp = LISP_TO_VOID (list2 (text_field_callback,
  1109.                                            build_string (text_field_value)));
  1110.       menubar_selection_callback (0, id, (XtPointer) tmp);
  1111.       xfree (text_field_value);
  1112.     }
  1113.     }
  1114.   free_widget_value (wv);
  1115. }
  1116.  
  1117. static void
  1118. dbox_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
  1119. {
  1120.   /* This is called with client_data == -1 when WM_DELETE_WINDOW is sent
  1121.      instead of a button being selected. */
  1122.   struct device *d = get_device_from_display (XtDisplay (widget));
  1123.   struct frame *f = 0;
  1124.   Widget cur_widget = widget;
  1125.  
  1126.   /* The parent which is actually connected to our EmacsFrame may be a
  1127.      ways up the tree. */
  1128.   while (!f && cur_widget)
  1129.     {
  1130.       f = x_any_window_to_frame (d, XtWindow (cur_widget));
  1131.       cur_widget = XtParent (cur_widget);
  1132.     }
  1133.  
  1134.   if (popup_handled_p (id))
  1135.     return;
  1136.   assert (popup_menu_up_p != 0);
  1137.   ungcpro_popup_callbacks (id);
  1138.   popup_menu_up_p--;
  1139.   maybe_run_dbox_text_callback (id);
  1140.   menubar_selection_callback (widget, id, client_data);
  1141.   lw_destroy_all_widgets (id);
  1142.  
  1143.   /* The Motif dialog box sets the keyboard focus to itself.  When it
  1144.      goes away we have to take care of getting the focus back
  1145.      ourselves. */
  1146. #ifdef EXTERNAL_WIDGET
  1147.   /* #### Not sure if this special case is necessary. */
  1148.   if (!FRAME_X_EXTERNAL_WINDOW_P (f) && f)
  1149. #else
  1150.   if (f)
  1151. #endif
  1152.     lw_set_keyboard_focus (FRAME_X_SHELL_WIDGET (f), FRAME_X_TEXT_WIDGET (f));
  1153. }
  1154.  
  1155. #endif /* HAVE_DIALOG_BOXES */
  1156.  
  1157.  
  1158. static void
  1159. make_dummy_xbutton_event (XEvent *dummy,
  1160.               Widget daddy,    
  1161.               struct Lisp_Event *eev)
  1162.      /* NULL for eev means query pointer */
  1163. {
  1164.   XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
  1165.  
  1166.   btn->type = ButtonPress;
  1167.   btn->serial = 0;
  1168.   btn->send_event = 0;
  1169.   btn->display = XtDisplay (daddy);
  1170.   btn->window = XtWindow (daddy);
  1171.   if (eev)
  1172.     {
  1173.       Position shellx, shelly, framex, framey;
  1174.       Widget shell = XtParent (daddy);
  1175.       btn->time = eev->timestamp;
  1176.       btn->button = eev->event.button.button;
  1177.       btn->root = RootWindowOfScreen (XtScreen (daddy));
  1178.       btn->subwindow = (Window) NULL;
  1179.       btn->x = eev->event.button.x;
  1180.       btn->y = eev->event.button.y;
  1181.       XtVaGetValues (shell, XtNx, &shellx, XtNy, &shelly, NULL);
  1182.       XtVaGetValues (daddy, XtNx, &framex, XtNy, &framey, NULL);
  1183.       btn->x_root = shellx + framex + btn->x;
  1184.       btn->y_root = shelly + framey + btn->y;;
  1185.       btn->state = ButtonPressMask; /* all buttons pressed */
  1186.     }
  1187.   else
  1188.     {
  1189.       /* CurrentTime is just ZERO, so it's worthless for
  1190.      determining relative click times. */
  1191.       struct device *d = get_device_from_display (XtDisplay (daddy));
  1192.       btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
  1193.       btn->button = 0;
  1194.       XQueryPointer (btn->display, btn->window, &btn->root,
  1195.              &btn->subwindow, &btn->x_root, &btn->y_root,
  1196.              &btn->x, &btn->y, &btn->state);
  1197.     }
  1198. }
  1199.  
  1200. DEFUN ("popup-menu", Fpopup_menu, Spopup_menu, 1, 2, 0,
  1201.        "Pop up the given menu.\n\
  1202. A menu description is a list of menu items, strings, and submenus.\n\
  1203. \n\
  1204. The first element of a menu must be a string, which is the name of the menu.\n\
  1205. This is the string that will be displayed in the parent menu, if any.  For\n\
  1206. toplevel menus, it is ignored.  This string is not displayed in the menu\n\
  1207. itself.\n\
  1208. \n\
  1209. If an element of a menu is a string, then that string will be presented in\n\
  1210. the menu as unselectable text.\n\
  1211. \n\
  1212. If an element of a menu is a string consisting solely of hyphens, then that\n\
  1213. item will be presented as a solid horizontal line.\n\
  1214. \n\
  1215. If an element of a menu is a list, it is treated as a submenu.  The name of\n\
  1216. that submenu (the first element in the list) will be used as the name of the\n\
  1217. item representing this menu on the parent.\n\
  1218. \n\
  1219. Otherwise, the element must be a vector, which describes a menu item.\n\
  1220. A menu item can have any of the following forms:\n\
  1221. \n\
  1222.  [ \"name\" callback <active-p> ]\n\
  1223.  [ \"name\" callback <active-p> \"suffix\" ]\n\
  1224.  [ \"name\" callback :<keyword> <value>  :<keyword> <value> ... ]\n\
  1225. \n\
  1226. The name is the string to display on the menu; it is filtered through the\n\
  1227. resource database, so it is possible for resources to override what string\n\
  1228. is actually displayed.\n\
  1229. \n\
  1230. If the `callback' of a menu item is a symbol, then it must name a command.\n\
  1231. It will be invoked with `call-interactively'.  If it is a list, then it is\n\
  1232. evaluated with `eval'.\n\
  1233. \n\
  1234. The possible keywords are this:\n\
  1235. \n\
  1236.  :active   <form>    Same as <active-p> in the first two forms: the\n\
  1237.                      expression is evaluated just before the menu is\n\
  1238.                      displayed, and the menu will be selectable only if\n\
  1239.                      the result is non-nil.\n\
  1240. \n\
  1241.  :suffix   \"string\"  Same as \"suffix\" in the second form: the suffix is\n\
  1242.                      appended to the displayed name, providing a convenient\n\
  1243.                      way of adding the name of a command's ``argument'' to\n\
  1244.                      the menu, like ``Kill Buffer NAME''.\n\
  1245. \n\
  1246.  :keys     \"string\"  Normally, the keyboard equivalents of commands in\n\
  1247.                      menus are displayed when the `callback' is a symbol.\n\
  1248.                      This can be used to specify keys for more complex menu\n\
  1249.                      items.  It is passed through `substitute-command-keys'\n\
  1250.                      first.\n\
  1251. \n\
  1252.  :style    <style>   Specifies what kind of object this menu item is:\n\
  1253. \n\
  1254.                         nil     A normal menu item.\n\
  1255.                         toggle  A toggle button.\n\
  1256.                         radio   A radio button.\n\
  1257. \n\
  1258.                      The only difference between toggle and radio buttons is\n\
  1259.                      how they are displayed.  But for consistency, a toggle\n\
  1260.                      button should be used when there is one option whose\n\
  1261.                      value can be turned on or off, and radio buttons should\n\
  1262.                      be used when there is a set of mutally exclusive\n\
  1263.                      options.  When using a group of radio buttons, you\n\
  1264.                      should arrange for no more than one to be marked as\n\
  1265.                      selected at a time.\n\
  1266. \n\
  1267.  :selected <form>    Meaningful only when STYLE is `toggle' or `radio'.\n\
  1268.                      This specifies whether the button will be in the\n\
  1269.                      selected or unselected state.\n\
  1270. \n\
  1271. For example:\n\
  1272. \n\
  1273.  [ \"Save As...\"    write-file  t ]\n\
  1274.  [ \"Revert Buffer\" revert-buffer (buffer-modified-p) ]\n\
  1275.  [ \"Read Only\"     toggle-read-only :style toggle :selected buffer-read-only ]\n\
  1276. \n\
  1277. See menubar.el for many more examples.")
  1278.      (menu_desc, event)
  1279.      Lisp_Object menu_desc, event;
  1280. {
  1281.   int menu_id;
  1282.   struct frame *f = selected_frame ();
  1283.   widget_value *data;
  1284.   Widget parent;
  1285.   Widget menu;
  1286.   struct Lisp_Event *eev = NULL;
  1287.   XEvent xev;
  1288.  
  1289.   if (!FRAME_IS_X (f))
  1290.     error ("not an X frame");
  1291.   else
  1292.     parent = FRAME_X_SHELL_WIDGET (f);
  1293.  
  1294.   if (!NILP (event))
  1295.     {
  1296.       CHECK_LIVE_EVENT (event, 0);
  1297.       eev= XEVENT (event);
  1298.       if (eev->event_type != button_press_event
  1299.       && eev->event_type != button_release_event)
  1300.     wrong_type_argument (Qmouse_event_p, event);
  1301.     }
  1302.   else if (!NILP (Vthis_command_keys))
  1303.     {
  1304.       /* if an event wasn't passed, use the last event of the event sequence
  1305.      currently being executed, if that event is a mouse event */
  1306.       eev = XEVENT (Vthis_command_keys); /* last event first */
  1307.       if (eev->event_type != button_press_event
  1308.       && eev->event_type != button_release_event)
  1309.     eev = NULL;
  1310.     }
  1311.   make_dummy_xbutton_event (&xev, parent, eev);
  1312.  
  1313.   if (SYMBOLP (menu_desc))
  1314.     menu_desc = Fsymbol_value (menu_desc);
  1315.   CHECK_CONS (menu_desc, 0);
  1316.   CHECK_STRING (XCAR (menu_desc), 0);
  1317.   data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
  1318.  
  1319.   if (! data) error ("no menu");
  1320.   
  1321.   menu_id = new_lwlib_id ();
  1322.   menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
  1323.                parent, 1, 0,
  1324.                popup_selection_callback, popup_down_callback);
  1325.   free_menubar_widget_value_tree (data);
  1326.  
  1327.   gcpro_popup_callbacks (menu_id);
  1328.  
  1329.   /* Setting zmacs-region-stays is necessary here because executing a command
  1330.      from a menu is really a two-command process: the first command (bound to
  1331.      the button-click) simply pops up the menu, and returns.  This causes a
  1332.      sequence of magic-events (destined for the popup-menu widget) to begin.
  1333.      Eventually, a menu item is selected, and a menu-event blip is pushed onto
  1334.      the end of the input stream, which is then executed by the event loop.
  1335.      
  1336.      So there are two command-events, with a bunch of magic-events between
  1337.      them.  We don't want the *first* command event to alter the state of the
  1338.      region, so that the region can be available as an argument for the second
  1339.      command.
  1340.    */
  1341.   if (zmacs_regions)
  1342.     zmacs_region_stays = 1;
  1343.  
  1344.   popup_menu_up_p++;
  1345.   lw_popup_menu (menu, &xev);
  1346.   /* this speeds up display of pop-up menus */
  1347.   XFlush (XtDisplay (parent));
  1348.   return Qnil;
  1349. }
  1350.  
  1351. DEFUN ("popup-menu-up-p", Fpopup_menu_up_p, Spopup_menu_up_p, 0, 0, 0,
  1352.        "Return t if a popup menu is up, nil otherwise.\n\
  1353. See `popup-menu'.")
  1354.      ()
  1355. {
  1356.   return popup_menu_up_p ? Qt : Qnil;
  1357. }
  1358.  
  1359. #ifdef HAVE_DIALOG_BOXES
  1360.  
  1361. static CONST char * CONST button_names [] = {
  1362.   "button1", "button2", "button3", "button4", "button5",
  1363.   "button6", "button7", "button8", "button9", "button10" };
  1364.  
  1365. /* can't have static frame locals because of some broken compilers */
  1366. static char tmp_dbox_name [255];
  1367.  
  1368. static widget_value *
  1369. dbox_descriptor_to_widget_value (Lisp_Object desc)
  1370. {
  1371.   /* !!#### This function has not been Mule-ized */
  1372.   /* This function can GC */
  1373.   char *name;
  1374.   int lbuttons = 0, rbuttons = 0;
  1375.   int partition_seen = 0;
  1376.   int text_field_p = 0;
  1377.   int allow_text_p = 1;
  1378.   widget_value *prev = 0, *kids = 0;
  1379.   int n = 0;
  1380.   int count = specpdl_depth ();
  1381.   Lisp_Object wv_closure;
  1382.  
  1383.   CHECK_CONS (desc, 0);
  1384.   CHECK_STRING (XCAR (desc), 0);
  1385.   name = (char *) string_data (XSTRING (LISP_GETTEXT (XCAR (desc))));
  1386.   desc = XCDR (desc);
  1387.   if (!CONSP (desc))
  1388.     error ("dialog boxes must have some buttons");
  1389.  
  1390.   /* Inhibit GC during this conversion.  The reasons for this are
  1391.      the same as in menu_item_descriptor_to_widget_value(); see
  1392.      the large comment above. */
  1393.  
  1394.   record_unwind_protect (restore_gc_inhibit,
  1395.              make_number (gc_currently_forbidden));
  1396.   gc_currently_forbidden = 1;
  1397.  
  1398.   kids = prev = xmalloc_widget_value ();
  1399.  
  1400.   /* Also make sure that we free the partially-created widget_value
  1401.      tree on Lisp error. */
  1402.  
  1403.   wv_closure = make_opaque_ptr (kids);
  1404.   record_unwind_protect (widget_value_unwind, wv_closure);
  1405.   prev->name = "message";
  1406.   prev->value = xstrdup (name);
  1407.   prev->enabled = 1;
  1408.  
  1409.   for (; !NILP (desc); desc = Fcdr (desc))
  1410.     {
  1411.       Lisp_Object button = XCAR (desc);
  1412.       widget_value *wv;
  1413.  
  1414.       if (NILP (button))
  1415.     {
  1416.       if (partition_seen)
  1417.         error ("more than one partition (nil) seen in dbox spec");
  1418.       partition_seen = 1;
  1419.       continue;
  1420.     }
  1421.       CHECK_VECTOR (button, 0);
  1422.       wv = xmalloc_widget_value ();
  1423.  
  1424.       if (!menu_item_leaf_to_widget_value (button, wv, allow_text_p, 1))
  1425.     {
  1426.       free_widget_value (wv);
  1427.       continue;
  1428.     }
  1429.  
  1430.       if (wv->type == TEXT_TYPE)
  1431.     {
  1432.       text_field_p = 1;
  1433.       allow_text_p = 0;     /* only allow one */
  1434.     }
  1435.       else            /* it's a button */
  1436.     {
  1437.       allow_text_p = 0;     /* only allow text field at the front */
  1438.       wv->value = xstrdup (wv->name);    /* what a mess... */
  1439.       wv->name = (char *) button_names [n];
  1440.  
  1441.       if (partition_seen)
  1442.         rbuttons++;
  1443.       else
  1444.         lbuttons++;
  1445.       n++;
  1446.  
  1447.       if (lbuttons > 9 || rbuttons > 9)
  1448.         error ("too many buttons (9)"); /* #### this leaks */
  1449.     }
  1450.  
  1451.       prev->next = wv;
  1452.       prev = wv;
  1453.     }
  1454.  
  1455.   if (n == 0)
  1456.     error ("dialog boxes must have some buttons");
  1457.   {
  1458.     char type = (text_field_p ? 'P' : 'Q');
  1459.     widget_value *dbox;
  1460.     sprintf (tmp_dbox_name, "%c%dBR%d", type, lbuttons + rbuttons, rbuttons);
  1461.     dbox = xmalloc_widget_value ();
  1462.     dbox->name = tmp_dbox_name;
  1463.     dbox->contents = kids;
  1464.  
  1465.     /* No more need to free the half-filled-in structures. */
  1466.     set_opaque_ptr (wv_closure, 0);
  1467.     unbind_to (count, Qnil);
  1468.     return dbox;
  1469.   }
  1470. }
  1471.  
  1472. DEFUN ("popup-dialog-box", Fpopup_dialog_box, Spopup_dialog_box, 1, 1, 0,
  1473.        "Pop up a dialog box.\n\
  1474. A dialog box description is a list.\n\
  1475. \n\
  1476. The first element of a dialog box must be a string, which is the title or\n\
  1477. question.\n\
  1478. \n\
  1479. The rest of the elements are descriptions of the dialog box's buttons.\n\
  1480. Each of these is a vector, the syntax of which is essentially the same as\n\
  1481. that of popup menu items.  They may have any of the following forms:\n\
  1482. \n\
  1483.  [ \"name\" callback <active-p> ]\n\
  1484.  [ \"name\" callback <active-p> \"suffix\" ]\n\
  1485.  [ \"name\" callback :<keyword> <value>  :<keyword> <value> ... ]\n\
  1486. \n\
  1487. The name is the string to display on the button; it is filtered through the\n\
  1488. resource database, so it is possible for resources to override what string\n\
  1489. is actually displayed.\n\
  1490. \n\
  1491. If the `callback' of a button is a symbol, then it must name a command.\n\
  1492. It will be invoked with `call-interactively'.  If it is a list, then it is\n\
  1493. evaluated with `eval'.\n\
  1494. \n\
  1495. One (and only one) of the buttons may be `nil'.  This marker means that all\n\
  1496. following buttons should be flushright instead of flushleft.\n\
  1497. \n\
  1498. Though the keyword/value syntax is supported for dialog boxes just as in \n\
  1499. popup menus, the only keyword which is both meaningful and fully implemented\n\
  1500. for dialog box buttons is `:active'.")
  1501.      (dbox_desc)
  1502.      Lisp_Object dbox_desc;
  1503. {
  1504.   int dbox_id;
  1505.   struct frame *f = selected_frame ();
  1506.   widget_value *data;
  1507.   Widget parent, dbox;
  1508.  
  1509.   if (!FRAME_IS_X (f)) error ("not an X frame");
  1510.   if (SYMBOLP (dbox_desc))
  1511.     dbox_desc = Fsymbol_value (dbox_desc);
  1512.   CHECK_CONS (dbox_desc, 0);
  1513.   CHECK_STRING (XCAR (dbox_desc), 0);
  1514.   data = dbox_descriptor_to_widget_value (dbox_desc);
  1515.  
  1516.   parent = FRAME_X_SHELL_WIDGET (f);
  1517.  
  1518.   dbox_id = new_lwlib_id ();
  1519.   dbox = lw_create_widget (data->name, "dialog", dbox_id, data, parent, 1, 0,
  1520.                dbox_selection_callback, 0);
  1521.   lw_modify_all_widgets (dbox_id, data, True);
  1522.   lw_modify_all_widgets (dbox_id, data->contents, True);
  1523.   free_menubar_widget_value_tree (data);
  1524.  
  1525.   gcpro_popup_callbacks (dbox_id);
  1526.  
  1527.   /* Setting zmacs-region-stays is necessary here because executing a command
  1528.      from a menu is really a two-command process: the first command (bound to
  1529.      the button-click) simply pops up the menu, and returns.  This causes a
  1530.      sequence of magic-events (destined for the popup-menu widget) to begin.
  1531.      Eventually, a menu item is selected, and a menu-event blip is pushed onto
  1532.      the end of the input stream, which is then executed by the event loop.
  1533.      
  1534.      So there are two command-events, with a bunch of magic-events between
  1535.      them.  We don't want the *first* command event to alter the state of the
  1536.      region, so that the region can be available as an argument for the second
  1537.      command.
  1538.    */
  1539.   if (zmacs_regions)
  1540.     zmacs_region_stays = 1;
  1541.  
  1542.   popup_menu_up_p++;
  1543.   lw_pop_up_all_widgets (dbox_id);
  1544.   return Qnil;
  1545. }
  1546. #endif /* HAVE_DIALOG_BOXES */
  1547.  
  1548.  
  1549. #ifdef ENERGIZE
  1550. extern int desired_debuggerpanel_exposed_p;
  1551. extern int current_debuggerpanel_exposed_p;
  1552. extern int debuggerpanel_sheet;
  1553. extern void notify_energize_sheet_hidden (unsigned long);
  1554. #endif
  1555.  
  1556. /* #### I don't think that the `inhibit_menubar_change' flag
  1557.    has any real purpose.  Its only use seems to be so that
  1558.    update_frame_menubar() can still update the Energize-specific
  1559.    windows even when the menubar shouldn't be updated.
  1560.    Instead of doing it this way, the Energize junk should
  1561.    be separated out from this function.  --Ben */
  1562.  
  1563. static void
  1564. x_update_frame_menubar_internal (struct frame *f, int inhibit_menubar_change)
  1565. {
  1566.   /* We assume the menubar contents has changed if the global flag is set,
  1567.      or if the current buffer has changed, or if the menubar has never
  1568.      been updated before.
  1569.    */
  1570.   int menubar_contents_changed =
  1571.     (f->menubar_changed
  1572.      || NILP (f->menubar_data)
  1573.      || (!EQ (FRAME_MENUBAR_DATA (f)->last_menubar_buffer,
  1574.           XWINDOW (f->selected_window)->buffer)));
  1575.  
  1576.   int menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
  1577.   int menubar_will_be_visible = menubar_was_visible;
  1578.   int menubar_visibility_changed;
  1579.   Cardinal new_num_top_widgets = 1; /* for the menubar */
  1580.   Widget container = FRAME_X_CONTAINER_WIDGET (f);
  1581.   
  1582. #ifdef ENERGIZE
  1583.   int *old_sheets = FRAME_X_CURRENT_PSHEETS (f);
  1584.   int *new_sheets = FRAME_X_DESIRED_PSHEETS (f);
  1585.   int old_count = FRAME_X_CURRENT_PSHEET_COUNT (f);
  1586.   int new_count = FRAME_X_DESIRED_PSHEET_COUNT (f);
  1587.   Lisp_Object old_buf = FRAME_X_CURRENT_PSHEET_BUFFER (f);
  1588.   Lisp_Object new_buf = FRAME_X_DESIRED_PSHEET_BUFFER (f);
  1589.   int psheets_changed = (old_sheets != new_sheets
  1590.              || old_count != new_count
  1591.              || !EQ (old_buf, new_buf));
  1592.   int debuggerpanel_changed = (desired_debuggerpanel_exposed_p
  1593.                    != current_debuggerpanel_exposed_p);
  1594.  
  1595.   if (desired_debuggerpanel_exposed_p && FRAME_X_TOP_WIDGETS (f) [1] == 0)
  1596.     /* This happens when the frame was just created. */
  1597.     debuggerpanel_changed = 1;
  1598.  
  1599.   FRAME_X_CURRENT_PSHEETS (f) = FRAME_X_DESIRED_PSHEETS (f);
  1600.   FRAME_X_CURRENT_PSHEET_COUNT (f) = FRAME_X_DESIRED_PSHEET_COUNT (f);
  1601.   FRAME_X_CURRENT_PSHEET_BUFFER (f) = FRAME_X_DESIRED_PSHEET_BUFFER (f);
  1602. #endif /* ENERGIZE */
  1603.  
  1604.   if (menubar_contents_changed && !inhibit_menubar_change)
  1605.     menubar_will_be_visible = set_frame_menubar (f, 0, 0);
  1606.  
  1607.   menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
  1608.  
  1609.   if (! (menubar_visibility_changed
  1610. #ifdef ENERGIZE
  1611.      || psheets_changed || debuggerpanel_changed
  1612. #endif
  1613.      ))
  1614.     return;
  1615.  
  1616.  
  1617.   /* Set menubar visibility */
  1618.   if (menubar_visibility_changed)
  1619.     (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
  1620.       (FRAME_X_MENUBAR_WIDGET (f));
  1621.          
  1622.  
  1623. #ifdef ENERGIZE
  1624.   /* Set debugger panel visibility */
  1625.   if (debuggerpanel_changed)
  1626.     {
  1627.       Widget w;
  1628.       int sheet = debuggerpanel_sheet;
  1629.  
  1630.       w = lw_get_widget (sheet, container, 0);
  1631.       if (desired_debuggerpanel_exposed_p)
  1632.     {
  1633.       if (! w)
  1634.         w = lw_make_widget (sheet, container, 0);
  1635.       FRAME_X_TOP_WIDGETS (f)[1] = w;
  1636.       XtManageChild (w);
  1637.     }
  1638.       else
  1639.     {
  1640.       notify_energize_sheet_hidden (sheet);
  1641.       if (w)
  1642.         XtUnmanageChild (w);
  1643.     }
  1644.     }
  1645.  
  1646.   /* Set psheet visibility.  For the moment we just unmanage all the old
  1647.    ones, and then manage all the new ones.  If the number of psheets
  1648.    ever becomes a large number (i.e. > 1), then we can worry about a
  1649.    more sophisticated way of doing this. */
  1650.   if (psheets_changed)
  1651.     {
  1652.       int i;
  1653.       Widget w;
  1654.       unsigned long sheet;
  1655.  
  1656.       for (i=0; i<old_count; i++)
  1657.     {
  1658.       sheet = old_sheets[i];
  1659.       w = lw_get_widget (sheet, container, 0);
  1660.       notify_energize_sheet_hidden (sheet);
  1661.       if (w)
  1662.         XtUnmanageChild (w);
  1663.     }
  1664.  
  1665.       for (i=0; i<new_count; i++)
  1666.     {
  1667.       sheet = new_sheets[i];
  1668.       /* #### This unconditional call to lw_make_widget() is a bad
  1669.          idea.  Doesn't it cause a memory leak if the widget
  1670.          already exists?
  1671.  
  1672.          #### How does Energize know that a sheet just got displayed?
  1673.          #### Energize knows all.  */
  1674.       w = lw_make_widget (sheet, container, 0);
  1675.       FRAME_X_TOP_WIDGETS (f)[2+i] = w;
  1676.       XtManageChild (w);
  1677.     }
  1678.     }
  1679.  
  1680.   new_num_top_widgets += 1+new_count;
  1681. #endif /* ENERGIZE */
  1682.  
  1683.   /* Note that new_num_top_widgets doesn't need to reflect the actual
  1684.      number of top widgets, but just the limit of FRAME_X_TOP_WIDGETS (f)[]. */
  1685.   FRAME_X_NUM_TOP_WIDGETS (f) = new_num_top_widgets;
  1686.   {
  1687.     /* We want to end up as close in size as possible to what we
  1688.        were before.  So, ask the EmacsManager what size it wants
  1689.        to be (suggesting the current size), and resize it to that
  1690.        size.  It in turn will call our query-geometry callback,
  1691.        which will round the size to something that exactly fits
  1692.        the text widget. */
  1693.     XtWidgetGeometry req, repl;
  1694.  
  1695.     req.request_mode = CWWidth | CWHeight;
  1696.     XtVaGetValues (container,
  1697.            XtNwidth, &req.width,
  1698.            XtNheight, &req.height,
  1699.            0);
  1700.     XtQueryGeometry (container, &req, &repl);
  1701.     EmacsManagerChangeSize (container, repl.width,
  1702.                 repl.height);
  1703.     /* The window size might not have changed but the text size
  1704.        did; thus, the base size might be incorrect.  So update
  1705.        it. */
  1706.     EmacsShellUpdateSizeHints (FRAME_X_SHELL_WIDGET (f));
  1707.   }
  1708.  
  1709. #ifdef ENERGIZE
  1710.   /* Give back the focus to emacs if no psheets are displayed anymore */
  1711.   if (psheets_changed)
  1712.     {
  1713.       Lisp_Object frame;
  1714.       XSETFRAME (frame, f);
  1715.       Fselect_frame (frame);
  1716.     }
  1717. #endif /* ENERGIZE */
  1718. }
  1719.  
  1720. static void
  1721. x_update_frame_menubars (struct frame *f)
  1722. {
  1723.   assert (FRAME_IS_X (f));
  1724.  
  1725.   /* The minibuffer does not have its own menubar, but uses whatever
  1726.      menubar is already there.  This avoids unseemly menubar
  1727.      flashing. */
  1728.   if (MINI_WINDOW_P (XWINDOW (f->selected_window)))
  1729.     x_update_frame_menubar_internal (f, 1);
  1730.   else
  1731.     x_update_frame_menubar_internal (f, 0);
  1732.  
  1733.   /* #### This isn't going to work right now that this function works on
  1734.      a per-frame, not per-device basis.  Guess what?  I don't care. */
  1735. #ifdef ENERGIZE
  1736.   current_debuggerpanel_exposed_p = desired_debuggerpanel_exposed_p;
  1737. #endif
  1738. }
  1739.  
  1740. void
  1741. free_frame_menubar (struct frame *f)    /* called from delete_frame_internal */
  1742. {
  1743.   Widget menubar_widget;
  1744.   if (! FRAME_IS_X (f))
  1745.     return;
  1746.   
  1747.   menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
  1748.   if (menubar_widget)
  1749.     {
  1750.       LWLIB_ID id = FRAME_MENUBAR_DATA (f)->id;
  1751.       lw_destroy_all_widgets (id);
  1752.       FRAME_MENUBAR_DATA (f)->id = 0;
  1753.     }
  1754.  
  1755. #ifdef ENERGIZE
  1756.   {
  1757.     /* Also destroy this frame's psheets */
  1758.     Widget parent = FRAME_X_CONTAINER_WIDGET (f);
  1759.     int *sheets = FRAME_X_CURRENT_PSHEETS (f);
  1760.     int i = FRAME_X_CURRENT_PSHEET_COUNT (f);
  1761.     while (i--)
  1762.       {
  1763.     unsigned long sheet = sheets [i];
  1764.     Widget w = lw_get_widget (sheet, parent, 0);
  1765.     if (w)
  1766.       lw_destroy_widget (w);
  1767.       }
  1768.     FRAME_X_CURRENT_PSHEET_COUNT (f) = 0;
  1769.  
  1770.     /* Is this necessary? */
  1771.     sheets = FRAME_X_DESIRED_PSHEETS (f);
  1772.     i = FRAME_X_DESIRED_PSHEET_COUNT (f);
  1773.     while (i--)
  1774.       {
  1775.     unsigned long sheet = sheets [i];
  1776.     Widget w = lw_get_widget (sheet, parent, 0);
  1777.     if (w)
  1778.       lw_destroy_widget (w);
  1779.       }
  1780.     FRAME_X_DESIRED_PSHEET_COUNT (f) = 0;
  1781.  
  1782.     /* sigh... debugger panel is special... */
  1783.     if (debuggerpanel_sheet)
  1784.       {
  1785.     Widget w = lw_get_widget (debuggerpanel_sheet, parent, 0);
  1786.     if (w)
  1787.       lw_destroy_widget (w);
  1788.       }
  1789.   }
  1790. #endif /* ENERGIZE */
  1791. }
  1792.  
  1793.  
  1794. /* This is a kludge to make sure emacs can only link against a version of
  1795.    lwlib that was compiled in the right way.  Emacs references symbols which
  1796.    correspond to the way it thinks lwlib was compiled, and if lwlib wasn't
  1797.    compiled in that way, then somewhat meaningful link errors will result.
  1798.    The alternatives to this range from obscure link errors, to obscure
  1799.    runtime errors that look a lot like bugs.
  1800.  */
  1801.  
  1802. static void
  1803. sanity_check_lwlib (void)
  1804. {
  1805. #define MACROLET(v) { extern int v; v = 1; }
  1806.  
  1807. #if (XlibSpecificationRelease == 4)
  1808.   MACROLET (lwlib_uses_x11r4);
  1809. #elif (XlibSpecificationRelease == 5)
  1810.   MACROLET (lwlib_uses_x11r5);
  1811. #elif (XlibSpecificationRelease == 6)
  1812.   MACROLET (lwlib_uses_x11r6);
  1813. #else
  1814.   MACROLET (lwlib_uses_unknown_x11);
  1815. #endif
  1816. #ifdef LWLIB_USES_MOTIF
  1817.   MACROLET (lwlib_uses_motif);
  1818. #else
  1819.   MACROLET (lwlib_does_not_use_motif);
  1820. #endif
  1821. #if (XmVersion >= 1002)
  1822.   MACROLET (lwlib_uses_motif_1_2);
  1823. #else
  1824.   MACROLET (lwlib_does_not_use_motif_1_2);
  1825. #endif
  1826. #ifdef LWLIB_MENUBARS_LUCID
  1827.   MACROLET (lwlib_menubars_lucid);
  1828. #else
  1829.   MACROLET (lwlib_menubars_motif);
  1830. #endif
  1831. #ifdef LWLIB_SCROLLBARS_LUCID
  1832.   MACROLET (lwlib_scrollbars_lucid);
  1833. #else
  1834. # ifdef LWLIB_SCROLLBARS_MOTIF
  1835.     MACROLET (lwlib_scrollbars_motif);
  1836. # else
  1837.     MACROLET (lwlib_scrollbars_athena);
  1838. # endif
  1839. #endif
  1840. #ifdef LWLIB_DIALOGS_MOTIF
  1841.   MACROLET (lwlib_dialogs_motif);
  1842. #else
  1843.   MACROLET (lwlib_dialogs_athena);
  1844. #endif
  1845. #ifdef ENERGIZE
  1846.   MACROLET (lwlib_uses_energize);
  1847. #else
  1848.   MACROLET (lwlib_does_not_use_energize);
  1849. #endif
  1850.  
  1851. #undef MACROLET
  1852. }
  1853.  
  1854.  
  1855. void
  1856. syms_of_menubar_x (void)
  1857. {
  1858.   defsubr (&Spopup_menu);
  1859.   defsubr (&Spopup_menu_up_p);
  1860.  
  1861. #ifdef HAVE_DIALOG_BOXES
  1862.   defsubr (&Spopup_dialog_box);
  1863. #endif
  1864. }
  1865.  
  1866. void
  1867. device_type_create_menubar_x (void)
  1868. {
  1869.   DEVICE_HAS_METHOD (x, update_frame_menubars);
  1870. }
  1871.  
  1872. void
  1873. vars_of_menubar_x (void)
  1874. {
  1875.   popup_menu_up_p = 0;
  1876.   last_popup_selection_callback_id = -1;
  1877.   lwlib_id_tick = (1<<16);    /* start big, to not conflict with Energize */
  1878.  
  1879.   Vpopup_callbacks = Qnil;
  1880.   staticpro (&Vpopup_callbacks);
  1881.  
  1882. #ifdef HAVE_DIALOG_BOXES
  1883.   Fprovide (intern ("dialog"));
  1884. #endif
  1885.  
  1886.   {
  1887.     /* put in Vblank_menubar a menubar value which has no visible
  1888.      * items.  This is a bit tricky due to various quirks.  We
  1889.      * could use '(["" nil nil]), but this is apparently equivalent
  1890.      * to '(nil), and a new frame created with this menubar will
  1891.      * get a vertically-squished menubar.  If we use " " as the
  1892.      * button title instead of "", we get an etched button border.
  1893.      * So we use
  1894.      *  '(("No active menubar" ["" nil nil]))
  1895.      * which creates a menu whose title is "No active menubar",
  1896.      * and this works fine.
  1897.      */
  1898.  
  1899.     Lisp_Object menu_item[3];
  1900.     char *blank_msg = "No active menubar";
  1901.  
  1902.     menu_item[0] = build_string ("");
  1903.     menu_item[1] = Qnil;
  1904.     menu_item[2] = Qnil;
  1905.     Vblank_menubar = Fcons (Fcons (build_string (blank_msg), 
  1906.                    Fcons (Fvector (3, &menu_item[0]), 
  1907.                       Qnil)),
  1908.                 Qnil);
  1909.     Vblank_menubar = Fpurecopy (Vblank_menubar);
  1910.     staticpro (&Vblank_menubar);
  1911.   }
  1912.  
  1913.   DEFVAR_BOOL ("popup-menu-titles", &popup_menu_titles,
  1914.            "If true, popup menus will have title bars at the top.");
  1915.   popup_menu_titles = 1;
  1916.  
  1917.   /* this makes only safe calls as in emacs.c */
  1918.   sanity_check_lwlib ();
  1919. }
  1920.